home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue42 / paradox / DBCheckU.pas next >
Encoding:
Pascal/Delphi Source File  |  1998-10-29  |  7.6 KB  |  263 lines
  1. unit DBCheckU;
  2.  
  3. {$ifdef Ver80} { Delphi 1.0x }
  4.   {$define DelphiLessThan4}
  5. {$endif}
  6. {$ifdef Ver90} { Delphi 2.0x }
  7.   {$define DelphiLessThan4}
  8. {$endif}
  9. {$ifdef Ver100} { Delphi 3.0x }
  10.   {$define DelphiLessThan4}
  11. {$endif}
  12.  
  13. interface
  14.  
  15. procedure CheckOKForParadoxAppToRun;
  16.  
  17. implementation
  18.  
  19. uses
  20. {$ifdef Win32}
  21.   Registry,
  22. {$else}
  23.   IniFiles,
  24. {$endif}
  25.   DbiProcs, DbiTypes, DbiErrs, DB, DBTables, Forms, SysUtils, Classes, Dialogs,
  26.   Winprocs, WinTypes;
  27.  
  28. const
  29.   RebootRequired: Boolean = False;
  30.  
  31. procedure CheckLocalShare;
  32. var
  33.   ASYSConfig: SYSConfig;
  34. begin
  35. {$ifdef Win32}
  36.   { Ensure BDE is initialised }
  37.   Session.Open;
  38. {$endif}
  39.   if (DbiGetSysConfig(ASYSConfig) = DbiErr_None) and
  40.      not ASYSConfig.bLocalShare then
  41.   begin
  42.     ShowMessage('BDE''s LOCAL SHARE flag must be TRUE for this ' +
  43.       'program to run. Ask your System Administrator to do this for ' +
  44.       'you.'#13#13'This program will not continue until this change ' +
  45.       'has been made and all BDE applications have been restarted');
  46.   {$ifdef Win32}
  47.     Application.ShowMainForm := False;
  48.   {$endif}
  49.     Application.Terminate;
  50.   end
  51. end;
  52.  
  53. {$ifdef Win32}
  54. function RestartDialog(Wnd: HWnd; Reason: PChar; Flags: Integer): Integer; stdcall;
  55. external 'shell32.dll' index 59;
  56.  
  57. type
  58.   TVersionNo = record
  59.     MS, LS: Cardinal;
  60.   end;
  61.  
  62. function VersionNumber(const FileName: String): TVersionNo;
  63. var
  64.   VerInfo: Pointer;
  65.   Len, BufSize: {$ifdef DelphiLessThan4}Integer{$else}Cardinal{$endif};
  66.   Dest: PVSFixedFileInfo;
  67. begin
  68.   FillChar(Result, SizeOf(Result), 0);
  69.   //How big is version info?
  70.   BufSize := GetFileVersionInfoSize(PChar(FileName), Len);
  71.   if BufSize > 0 then
  72.   begin
  73.     //Reserve sufficient memory
  74.     GetMem(VerInfo, BufSize);
  75.     try
  76.       //Get version information
  77.       if GetFileVersionInfo(PChar(FileName), 0, BufSize, VerInfo) then
  78.         //Get translation table
  79.         if VerQueryValue(VerInfo, '\', Pointer(Dest), Len) then
  80.           with Dest^ do
  81.           begin
  82.             Result.MS := dwFileVersionMS;
  83.             Result.LS := dwFileVersionLS
  84.           end
  85.     finally
  86.       //Free sufficient memory
  87.       FreeMem(VerInfo, BufSize)
  88.     end
  89.   end
  90. end;
  91.  
  92. procedure CheckRedirector;
  93.  
  94.   procedure CheckFile(const FileName, Vn: String; Hi, Lo: Cardinal);
  95.   var
  96.     Ver: TVersionNo;
  97.   const
  98.     ErrorA = 'You need a newer system file. %s is version %d.%d.%d.';
  99.     ErrorB = ' It should be version %s.'#13#13'Get an update to this file from ' +
  100.              'http://support.microsoft.com/download/support/mslfiles/vrdrupd.exe';
  101.     Error1 = ErrorA + ErrorB;
  102.     Error2 = ErrorA + '%d.' + ErrorB;
  103.   begin
  104.     Ver := VersionNumber(FileName);
  105.     if (Ver.MS < Hi) or ((Ver.MS = Hi) and (Ver.LS < Lo)) then
  106.       //If the high word of the low DWord of the version info is 0,
  107.       //the 0 is never written in MS version info strings
  108.       if HiWord(Ver.LS) = 0 then
  109.         ShowMessage(Format(Error1, [FileName, HiWord(Ver.MS),
  110.           LoWord(Ver.MS), LoWord(Ver.LS), Vn]))
  111.       else
  112.         ShowMessage(Format(Error2, [FileName, HiWord(Ver.MS),
  113.           LoWord(Ver.MS), HiWord(Ver.LS), LoWord(Ver.LS), Vn]))
  114.   end;
  115.  
  116. var
  117.   Dir: array[0..255] of Char;
  118. begin
  119.   GetSystemDirectory(Dir, SizeOf(Dir));
  120.   CheckFile(String(Dir) + '\VREDIR.VXD', '4.0.1116', $40000, 1116);
  121.   CheckFile(String(Dir) + '\VNETSUP.VXD', '4.0.1112', $40000, 1112);
  122. end;
  123.  
  124. procedure CheckRegistryEntry(Reg: TRegistry;
  125.   const Path, Value: String;
  126.   const Default, Desired: Variant; Size: Byte);
  127. var
  128.   TmpInt: Cardinal;
  129.   TmpStr: String;
  130. begin
  131.   with Reg do
  132.     if OpenKey(Path, True) then
  133.       try
  134.         case VarType(Desired) of
  135.           varInteger:
  136.             begin
  137.               TmpInt := Default;
  138.               if ValueExists(Value) then
  139.                 ReadBinaryData(Value, TmpInt, Size);
  140.               if TmpInt = Default then
  141.               begin
  142.                 TmpInt := Desired;
  143.                 WriteBinaryData(Value, TmpInt, Size);
  144.                 RebootRequired := True
  145.               end
  146.             end;
  147.           varString:
  148.             begin
  149.               TmpStr := Default;
  150.               if ValueExists(Value) then
  151.                 TmpStr := ReadString(Value);
  152.               if TmpStr = Default then
  153.               begin
  154.                 TmpStr := Desired;
  155.                 WriteString(Value, TmpStr);
  156.                 RebootRequired := True
  157.               end
  158.             end
  159.         end
  160.       finally
  161.         CloseKey
  162.       end
  163. end;
  164.  
  165. const
  166.   Control  = 'System\CurrentControlSet\Control\';
  167.   Services = 'System\CurrentControlSet\Services\';
  168.  
  169. procedure CheckWin95Registry;
  170. var
  171.   Reg: TRegistry;
  172. const
  173.   DOSRequester = 'Network\Novell\System Config\Netware Dos Requester';
  174. begin
  175.   Reg := TRegistry.Create;
  176.   try
  177.     Reg.RootKey := HKey_Local_Machine;
  178.     //Fix VREDIR.VxD settings
  179.     CheckRegistryEntry(Reg, Services + 'VxD\VREDIR', 'DiscardCacheOnOpen', 0, 1, SizeOf(Byte));
  180.     //Fix NWREDIR.VxD settings
  181.     CheckRegistryEntry(Reg, Services + 'VxD\NWREDIR', 'ReadCaching', 1, 0, SizeOf(Byte));
  182.     //Fix Novell settings
  183.     CheckRegistryEntry(Reg, DOSRequester, 'Cache Writes', 'Yes', 'No', 0);
  184.     CheckRegistryEntry(Reg, DOSRequester, 'Opportunistic Locking', 'Yes', 'No', 0);
  185.     //Fix FileSystem troubleshooting settings
  186.     CheckRegistryEntry(Reg, Control + 'FileSystem', 'DriveWriteBehind', $FFFFFFFF, 0, SizeOf(Longint));
  187.     {$define AllOptionsThatPeopleSuggest}
  188.     {$ifdef AllOptionsThatPeopleSuggest}
  189.     CheckRegistryEntry(Reg, Control + 'FileSystem', 'SoftCompatMode', 1, 0, SizeOf(Longint));
  190.     CheckRegistryEntry(Reg, Control + 'FileSystem', 'AsyncFileCommit', 0, 1, SizeOf(Byte));
  191.     {$endif}
  192.   finally
  193.     Reg.Free
  194.   end
  195. end;
  196.  
  197. procedure CheckWinNTRegistry;
  198. var
  199.   Reg: TRegistry;
  200. begin
  201.   Reg := TRegistry.Create;
  202.   try
  203.     Reg.RootKey := HKey_Local_Machine;
  204.     //Disable opportunistic locking & caching
  205.     CheckRegistryEntry(Reg, Services + 'LanmanServer\Parameters', 'EnableOpLocks', 1, 0, SizeOf(Byte));
  206.     CheckRegistryEntry(Reg, Services + 'LanmanWorkStation\Parameters', 'UseOpportunisticLocking', 1, 0, SizeOf(Longint));
  207.     CheckRegistryEntry(Reg, Services + 'LanmanWorkStation\Parameters', 'UtilizeNtCaching', 1, 0, SizeOf(Longint));
  208.     //Make sure NetWare popups are enabled to avoid a documented issue
  209.     CheckRegistryEntry(Reg, Services + 'NWCWorkstation\Parameters', 'DisablePopup', 1, 0, SizeOf(Longint));
  210.   finally
  211.     Reg.Free
  212.   end
  213. end;
  214. {$else}
  215. procedure CheckWin31Registry;
  216. begin
  217.   with TIniFile.Create('System.Ini') do
  218.     try
  219.       if ReadString('386Enh', 'ForceLazyOff', '') = '' then
  220.       begin
  221.         { You need to put appropriate value for data drive letters!!! }
  222.         WriteString('386Enh', 'ForceLazyOff', 'CDE');
  223.         RebootRequired := True
  224.       end
  225.     finally
  226.       Free
  227.     end
  228. end;
  229. {$endif}
  230.  
  231. procedure CheckRegistryIsAcceptable;
  232. begin
  233. {$ifdef Win32}
  234.   case Win32Platform of
  235.     VER_PLATFORM_WIN32_WINDOWS: CheckWin95Registry;
  236.     VER_PLATFORM_WIN32_NT:      CheckWinNTRegistry;
  237.   end;
  238.   if RebootRequired then
  239.     //Use standard Win32 reboot dialog
  240.     RestartDialog(0, nil, ew_RestartWindows)
  241. {$else}
  242.   CheckWin31Registry;
  243.   if RebootRequired then
  244.   begin
  245.     ShowMessage('Some system settings have been changed - Windows needs to restart');
  246.     ExitWindows(ew_RestartWindows, 0)
  247.   end
  248. {$endif}
  249. end;
  250.  
  251. procedure CheckOKForParadoxAppToRun;
  252. begin
  253.   {$ifdef Win32}
  254.   //Only Win95 redirector files need checking
  255.   if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
  256.     CheckRedirector;
  257.   {$endif}
  258.   CheckRegistryIsAcceptable;
  259.   CheckLocalShare;
  260. end;
  261.  
  262. end.
  263.